home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / darc31.zip / DEARCUSQ.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  2KB  |  131 lines
  1. (**
  2.  *
  3.  *  Module:       dearcusq.pas
  4.  *  Description:  DEARC unSqueezing routines (huffman encoding)
  5.  *
  6.  *  Revision History:
  7.  *    7-26-88: unitized for Turbo v4.0
  8.  *
  9. **)
  10.  
  11.  
  12. unit dearcusq;
  13.  
  14. interface
  15.  
  16. uses
  17.   dearcglb,
  18.   dearcabt,
  19.   dearcio,
  20.   dearcunp;
  21.  
  22. procedure init_usq;
  23. function getc_usq : integer;
  24.  
  25.  
  26. (*
  27.  *  definitions for unsqueeze
  28.  *)
  29. Const
  30.   ERROR   = -1;
  31.   SPEOF   = 256;
  32.   NUMVALS = 256;               { 1 less than the number of values }
  33.  
  34. Type
  35.   nd = record
  36.           child : array [0..1] of integer
  37.         end;
  38.  
  39. Var
  40.   node     : array [0..NUMVALS] of nd;
  41.   bpos     : integer;
  42.   curin    : integer;
  43.   numnodes : integer;
  44.  
  45. implementation
  46.  
  47.  
  48. (**
  49.  *
  50.  *  Name:         procedure init_usq
  51.  *  Description:  initialize for unsqueeze
  52.  *  Parameters:   none
  53.  *
  54. **)
  55. procedure init_usq;
  56. var
  57.   i : integer;
  58. begin
  59.   bpos := 99;
  60.  
  61.   fread(numnodes, sizeof(numnodes));
  62.  
  63.   if (numnodes < 0) or (numnodes > NUMVALS) then
  64.     abort('File has an invalid decode tree');
  65.  
  66.   node[0].child[0] := -(SPEOF + 1);
  67.   node[0].child[1] := -(SPEOF + 1);
  68.  
  69.   for i := 0 to numnodes-1 do
  70.     begin
  71.       fread(node[i].child[0], sizeof(integer));
  72.       fread(node[i].child[1], sizeof(integer))
  73.     end
  74. end; (* proc init_usq; *)
  75.  
  76.  
  77. (**
  78.  *
  79.  *  Name:         function getc_usq : integer
  80.  *  Description:  unsqueeze
  81.  *  Parameters:   none
  82.  *  Returns:      unsqueezed char
  83.  *
  84. **)
  85. function getc_usq : integer;
  86. label
  87.   exit;
  88. var
  89.   i : integer;
  90. begin
  91.   i := 0;
  92.  
  93.   while i >= 0 do
  94.     begin
  95.       bpos := bpos + 1;
  96.  
  97.       if bpos > 7 then
  98.         begin
  99.           curin := getc_unp;
  100.  
  101.           if curin = ERROR then
  102.             begin
  103.               getc_usq := ERROR;
  104.               goto exit                   (******** was "exit" ************)
  105.             end;
  106.  
  107.           bpos := 0;
  108.  
  109.           i := node[i].child[1 and curin]
  110.         end
  111.       else
  112.         begin
  113.           curin := curin shr 1;
  114.           i := node[i].child[1 and curin]
  115.         end
  116.     end; (* while *)
  117.  
  118.   i := - (i + 1);
  119.  
  120.   if i = SPEOF then
  121.     getc_usq := -1
  122.   else
  123.     getc_usq := i;
  124.  
  125.   exit:
  126. end; (* func getc_usq *)
  127.  
  128.  
  129. end.
  130.  
  131.